#
# Functions for standard (RFC 1891-1894) bounce messages
#
# Implements interface of Bounce::Mail
#

package Mail::Bounce::Standard;

use Mail::Bounce::Address;

use strict;

use vars qw(@ISA $DEBUG);

@ISA = qw(Mail::Bounce);

$DEBUG = 0;

sub isbounce {
    # if it is dispatched here, it is a bounce
    return 1;
}

sub recipients {
    my $self = shift;
    my @recipinfo;

    my ($report, $body, $globals, $thisrecip, $reporthost);

    $report = $self->parts(1); # Second part
    print "Type of part 2 is ", $report->mime_type, "\n" if $DEBUG;
    if ($report->mime_type eq "message/delivery-status") {
	my($n, $prevaction, $prevstatus, $line, @lines, $action, $status);
	my ($recipname, $fromuser);
	# We've got one! What do we do now?
	my $body = $report->bodyhandle;
	$body->print(\*STDOUT) if $DEBUG;
	# Take advantage of the fact that this looks like 822 headers...
	$globals = new Mail::Header;
	$globals->modify(0);
	my $text = $body->as_string();
        $DEBUG && print "Before unwrap:\n$text";
	$text =~ s/\n[ \t]//g; # unfold lines, brutally
	                   # NOTE: Another \n is a space, so \n\s
                           # removes blank lines too!
        $DEBUG && print "After unwrap:\n$text";
	@lines = split("\n", $text);
	while ($#lines >= 0 && ($line = shift @lines) ne "") {
	    print "Global: $line\n" if $DEBUG;
	    $globals->add(undef, $line);
	    $reporthost = $globals->get("reporting-mta");
	}
	$n = 0;
	$prevaction = "";
	$prevstatus = "";
	while ($#lines >= 0) {
	    ++ $n;
	    $thisrecip = new Mail::Header;
	    my $rrec = new Mail::Bounce::Address;
	    $thisrecip->modify(0);
	    while ($#lines >= 0 && ($line = shift @lines) ne "") {
		print "Recip $n: $line\n" if $DEBUG;
		if ($line =~ /^\S+:/) {
		    $thisrecip->add(undef, $line);
		} else {
		    die "Erroneous line: $line\n";
		}
	    }
	    die "No action found" if !$thisrecip->get("action");
	    $action = trim($thisrecip->get("action"));
	    if ($action eq "failure") {
		$DEBUG && warn "Strange value failure not failed\n";
		$action = "failed";
	    }
	    $status = trim($thisrecip->get("status"));
	    $recipname = trim($thisrecip->get("final-recipient"));
	    if ($recipname =~ s/^RFC822;\s+//i) {
		# Normalization - some emails come in as rfc822; <addr>
		# others come in as rfc822; addr
		my @addrs = Mail::Address->parse($recipname);
		die "No address in recipname $recipname" if @addrs < 1;
		die "Multiple address in recipname $recipname" if @addrs > 1;
		$recipname = "RFC822; " . $addrs[0]->address();
	    }
	    $action =~ tr/\r\n//d;
	    $status =~ tr/\r\n//d;
	    $rrec->action("\L$action");
	    $rrec->status($status);
	    $rrec->final_recipient($recipname);
	    if ("\L$action" eq "delayed") {
		$rrec->type("warning");
	    } elsif ("\L$action" eq "failed") {
		if ($status =~ /^4\./) {
		    $rrec->type("tempfail");
		} elsif ($status =~ /^5\./) {
		    $rrec->type("permfail");
		} elsif ($status eq "2.0.0") {
		    $rrec->type("permfail");
		    $rrec->diagnostic("Buggy AOL mailer reporting 2.0.0 failure");
		} else {
		    warn "ERR: Not understood: status $status\n";
		}
	    } else {
		print "ERR: Not understood: action $action\n";
	    }
	    $DEBUG && print "$recipname: $action $status at $reporthost\n";
	    push(@recipinfo, $rrec);
	}
	$DEBUG && print "Reported on $n recipient", $n>1?"s\n":"\n";
	# If we get here, there is only 1 action & status, so we
	# can take action on that. Mixed-mode messages go BOINK
	# at the moment.
    } else {
	die "ERR: not a message/delivery-status\n";
    }
    if (wantarray) {
	return @recipinfo;
    } else {
	return @recipinfo + 0;
    }
}

sub trim {
    my $arg = shift;
    $arg =~ s/\(.*\)//; # comments
    $arg =~ s/^\s+//;
    $arg =~ s/\s+$//;
    $arg;
}

1;
